      SUBROUTINE UFBSEQ(LUNIN,USR,I1,I2,IRET,STR)

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    UFBSEQ
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2000-09-19
C
C ABSTRACT: THIS SUBROUTINE WRITES OR READS SPECIFIED VALUES TO OR FROM
C   THE CURRENT BUFR DATA SUBSET WITHIN INTERNAL ARRAYS, WITH THE
C   DIRECTION OF THE DATA TRANSFER DETERMINED BY THE CONTEXT OF
C   ABS(LUNIN) {I.E., IF ABS(LUNIN) POINTS TO A BUFR FILE THAT IS OPEN
C   FOR INPUT, THEN DATA VALUES ARE READ FROM THE INTERNAL DATA SUBSET;
C   OTHERWISE, DATA VALUES ARE WRITTEN TO THE INTERNAL DATA SUBSET}.
C   THE DATA VALUES CORRESPOND TO A SEQUENCE OF TABLE B MNEMONICS WHICH
C   ARE REPRESENTED BY A SINGLE TABLE A OR TABLE D SEQUENCE MNEMONIC.
C   THIS SEQUENCE MNEMONIC MAY ITSELF CONTAIN ONE OR MORE TABLE D
C   SEQUENCE MNEMONICS ALONG WITH TABLE B MNEMONICS, THE SEQUENCE
C   MNEMONICS HERE CAN USE EITHER DELAYED REPLICATION, REGULAR (I.E.,
C   NON-DELAYED) REPLICATION OR THEY CAN HAVE NO REPLICATION AT ALL.
C   HOWEVER, IN CASES WHERE THIS SUBROUTINE IS WRITING DATA VALUES TO
C   SEQUENCES USING DELAYED-REPLICATION, THE APPLICATION PROGRAM MUST
C   FIRST CALL BUFR ARCHIVE LIBRARY ROUTINE DRFINI TO PRE-ALLOCATE THE
C   SPACE NEEDED TO EXPAND THE DELAYED-REPLICATION SEQUENCE (THE NUMBER
C   OF REPLICATIONS IN DELAYED-REPLICATION IS SET TO ZERO BY DEFAULT).
C   (SEE BUFR ARCHIVE LIBRARY DRFINI DOCBLOCK REMARKS FOR MORE
C   INFORMATION.) IF UFBSEQ IS READING VALUES, THEN EITHER BUFR ARCHIVE
C   LIBRARY SUBROUTINE READSB OR READNS MUST HAVE BEEN PREVIOUSLY
C   CALLED TO READ THE SUBSET FROM UNIT ABS(LUNIN) INTO INTERNAL
C   MEMORY.  IF IT IS WRITING VALUES, THEN EITHER BUFR ARCHIVE LIBRARY
C   SUBROUTINE OPENMG OR OPENMB MUST HAVE BEEN PREVIOUSLY CALLED TO
C   OPEN AND INITIALIZE A BUFR MESSAGE WITHIN MEMORY FOR THIS
C   ABS(LUNIN).
C
C PROGRAM HISTORY LOG:
C 2000-09-19  J. WOOLLEN -- ORIGINAL AUTHOR
C 2002-05-14  J. WOOLLEN -- IMPROVED GENERALITY, PREVIOUSLY UFBSEQ
C                           WOULD NOT RECOGNIZE COMPRESSED DELAYED
C                           REPLICATION AS A LEGITIMATE DATA STRUCTURE
C 2003-05-19  J. WOOLLEN -- CORRECTED THE LOGIC ARRAY OF EXIT
C                           CONDITIONS FOR THE SUBROUTINE, PREVIOUSLY,
C                           IN SOME CASES, PROPER EXITS WERE MISSED,
C                           GENERATING BOGUS ERROR MESSAGES, BECAUSE OF
C                           SEVERAL MISCELLANEOUS BUGS WHICH ARE NOW
C                           REMOVED
C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C                           INTERDEPENDENCIES
C 2003-11-04  D. KEYSER  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
C                           INCREASED FROM 15000 TO 16000 (WAS IN
C                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
C                           WRF; ADDED DOCUMENTATION (INCLUDING
C                           HISTORY); OUTPUTS MORE COMPLETE DIAGNOSTIC
C                           INFO WHEN ROUTINE TERMINATES ABNORMALLY OR
C                           UNUSUAL THINGS HAPPEN
C 2004-08-18  J. ATOR    -- ADDED SAVE FOR IFIRST1 AND IFIRST2 FLAGS
C 2007-01-19  J. ATOR    -- REPLACED CALL TO PARSEQ WITH CALL TO PARSTR
C 2009-04-21  J. ATOR    -- USE ERRWRT
C 2014-09-10  J. ATOR    -- FIX BUG INVOLVING NESTED DELAYED REPLICATION
C                           WHERE FIRST REPLICATION OF OUTER SEQUENCE
C                           DOES NOT CONTAIN A REPLICATION OF THE INNER
C                           SEQUENCE
C 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C
C USAGE:    CALL UFBSEQ (LUNIN, USR, I1, I2, IRET, STR)
C   INPUT ARGUMENT LIST:
C     LUNIN    - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT
C                NUMBER FOR BUFR FILE
C                  - IF BUFR FILE OPEN FOR OUTPUT AND LUNIN IS LESS
C                    THAN ZERO, UFBSEQ TREATS THE BUFR FILE AS THOUGH
C                    IT WERE OPEN FOR INPUT
C     USR      - ONLY IF BUFR FILE OPEN FOR OUTPUT:
C                   REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
C                   WRITTEN TO DATA SUBSET
C     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR (MUST BE AT
C                LEAST AS LARGE AS THE NUMBER OF UNIQUE TABLE B
C                MNEMONICS REPRESENTED BY THE SINGLE TABLE A OR TABLE D
C                SEQUENCE MNEMONIC IN STR)
C     I2       - INTEGER:
C                  - IF BUFR FILE OPEN FOR INPUT:  LENGTH OF SECOND
C                    DIMENSION OF USR
C                  - IF BUFR FILE OPEN FOR OUTPUT: NUMBER OF "LEVELS"
C                    OF DATA VALUES TO BE WRITTEN TO DATA SUBSET; THIS
C                    CORRESPONDS TO THE NUMBER OF REPLICATIONS OF THE
C                    MNEMONIC IN STR
C     STR      - CHARACTER*(*): STRING CONTAINING A SINGLE TABLE A OR
C                TABLE D SEQUENCE MNEMONIC WHOSE SEQUENCE OF TABLE B
C                MNEMONICS ARE IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
C                DIMENSION OF USR
C                  - IF BUFR FILE OPEN FOR INPUT: THERE ARE THREE
C                     "GENERIC" MNEMONICS NOT RELATED TO TABLE A OR D,
C                     THESE RETURN THE FOLLOWING INFORMATION IN
C                     CORRESPONDING USR LOCATION:
C                     'NUL'  WHICH ALWAYS RETURNS BMISS ("MISSING")
C                     'IREC' WHICH ALWAYS RETURNS THE CURRENT BUFR
C                            MESSAGE (RECORD) NUMBER IN WHICH THIS
C                            SUBSET RESIDES
C                     'ISUB' WHICH ALWAYS RETURNS THE CURRENT SUBSET
C                            NUMBER OF THIS SUBSET WITHIN THE BUFR
C                            MESSAGE (RECORD) NUMBER 'IREC'
C
C   OUTPUT ARGUMENT LIST:
C     USR      - ONLY IF BUFR FILE OPEN FOR INPUT:
C                   REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
C                   READ FROM DATA SUBSET
C     IRET     - INTEGER:
C                  - IF BUFR FILE OPEN FOR INPUT: NUMBER OF "LEVELS" OF
C                    DATA VALUES READ FROM DATA SUBSET (MUST BE NO
C                    LARGER THAN I2)
C                  - IF BUFR FILE OPEN FOR OUTPUT: NUMBER OF "LEVELS"
C                    OF DATA VALUES WRITTEN TO DATA SUBSET (SHOULD BE
C                    SAME AS I2)
C
C REMARKS:
C    THIS ROUTINE CALLS:        BORT     ERRWRT   INVTAG   INVWIN
C                               PARSTR   STATUS
C    THIS ROUTINE IS CALLED BY: None
C                               Normally called only by application
C                               programs.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE:  PORTABLE TO ALL PLATFORMS
C
C$$$

      USE MODA_USRINT
      USE MODA_MSGCWD
      USE MODA_TABLES

      INCLUDE 'bufrlib.prm'

      PARAMETER (MTAG=10)

      COMMON /QUIET / IPRT

      CHARACTER*(*) STR
      CHARACTER*156 BORT_STR
      CHARACTER*128 ERRSTR
      CHARACTER*10  TAGS(MTAG)
      REAL*8        USR(I1,I2)

      DATA IFIRST1/0/,IFIRST2/0/

      SAVE IFIRST1, IFIRST2

C----------------------------------------------------------------------
C----------------------------------------------------------------------

      IRET = 0

C  CHECK THE FILE STATUS AND I-NODE
C  --------------------------------

      LUNIT = ABS(LUNIN)
      CALL STATUS(LUNIT,LUN,IL,IM)
      IF(IL.EQ.0) GOTO 900
      IF(IM.EQ.0) GOTO 901

      IO = MIN(MAX(0,IL),1)
      IF(LUNIT.NE.LUNIN) IO = 0

      IF(I1.LE.0) THEN
         IF(IPRT.GE.0) THEN
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      ERRSTR = 'BUFRLIB: UFBSEQ - 3rd ARG. (INPUT) IS .LE. 0, ' //
     .   'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT(STR)
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL ERRWRT(' ')
         ENDIF
         GOTO 100
      ELSEIF(I2.LE.0) THEN
         IF(IPRT.EQ.-1)  IFIRST1 = 1
         IF(IO.EQ.0 .OR. IFIRST1.EQ.0 .OR. IPRT.GE.1)  THEN
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      ERRSTR = 'BUFRLIB: UFBSEQ - 4th ARG. (INPUT) IS .LE. 0, ' //
     .   'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT(STR)
            IF(IPRT.EQ.0 .AND. IO.EQ.1) THEN
      ERRSTR = 'Note: Only the first occurrence of this WARNING ' //
     .   'message is printed, there may be more.  To output all ' //
     .   'such messages,'
      CALL ERRWRT(ERRSTR)
      ERRSTR = 'modify your application program to add ' //
     .   '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
     .   'to a BUFRLIB routine.'
      CALL ERRWRT(ERRSTR)
            ENDIF
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL ERRWRT(' ')
            IFIRST1 = 1
         ENDIF
         GOTO 100
      ENDIF

C  CHECK FOR VALID SEQUENCE AND SEQUENCE LENGTH ARGUMENTS
C  ------------------------------------------------------

      CALL PARSTR(STR,TAGS,MTAG,NTAG,' ',.TRUE.)
      IF(NTAG.LT.1) GOTO 902
      IF(NTAG.GT.1) GOTO 903
      IF(I1.LE.0) GOTO 904
      IF(I2.LE.0) GOTO 905
      IF(INODE(LUN).NE.INV(1,LUN)) GOTO 906


C  INITIALIZE USR ARRAY PRECEEDING AN INPUT OPERATION
C  --------------------------------------------------

      IF(IO.EQ.0) THEN
         DO J=1,I2
         DO I=1,I1
         USR(I,J) = BMISS
         ENDDO
         ENDDO
      ENDIF


C  FIND THE PARAMETERS OF THE SPECIFIED SEQUENCE
C  ---------------------------------------------

      DO NODE=INODE(LUN),ISC(INODE(LUN))
      IF(STR.EQ.TAG(NODE)) THEN
         IF(TYP(NODE).EQ.'SEQ'.OR.TYP(NODE).EQ.'RPC') THEN
            INS1 = 1
5           INS1 = INVTAG(NODE,LUN,INS1,NVAL(LUN))
            IF(INS1.EQ.0) GOTO 200
            IF(TYP(NODE).EQ.'RPC'.AND.VAL(INS1,LUN).EQ.0.) THEN
               INS1 = INS1+1
               GOTO 5
            ENDIF
            INS2 = INVTAG(NODE,LUN,INS1+1,NVAL(LUN))
            IF(INS2.EQ.0) INS2 = 10E5
            NODS = NODE
            DO WHILE(LINK(NODS).EQ.0.AND.JMPB(NODS).GT.0)
            NODS = JMPB(NODS)
            ENDDO
            IF(LINK(NODS).EQ.0) THEN
               INSX = NVAL(LUN)
            ELSEIF(LINK(NODS).GT.0) THEN
               INSX = INVWIN(LINK(NODS),LUN,INS1+1,NVAL(LUN))-1
            ENDIF
            INS2 = MIN(INS2,INSX)
         ELSEIF(TYP(NODE).EQ.'SUB') THEN
            INS1 = 1
            INS2 = NVAL(LUN)
         ELSE
            GOTO 907
         ENDIF
         NSEQ = 0
         DO ISQ=INS1,INS2
         ITYP = ITP(INV(ISQ,LUN))
         IF(ITYP.GT.1) NSEQ = NSEQ+1
         ENDDO
         IF(NSEQ.GT.I1) GOTO 908
         GOTO 1
      ENDIF
      ENDDO

      GOTO 200

C  FRAME A SECTION OF THE BUFFER - RETURN WHEN NO FRAME
C  ----------------------------------------------------

1     INS1 = INVTAG(NODE,LUN,INS1,NVAL(LUN))
      IF(INS1.GT.NVAL(LUN)) GOTO 200
      IF(INS1.GT.0) THEN
         IF(TYP(NODE).EQ.'RPC'.AND.VAL(INS1,LUN).EQ.0.) THEN
            INS1 = INS1+1
            GOTO 1
         ELSEIF(IO.EQ.0.AND.IRET+1.GT.I2) THEN
            GOTO 909
         ENDIF
      ELSEIF(INS1.EQ.0) THEN
         IF(IO.EQ.1.AND.IRET.LT.I2) GOTO 910
      ELSE
         GOTO 911
      ENDIF

      IF(INS1.EQ. 0) GOTO 200
      IF(IRET.EQ.I2) GOTO 200

      IRET = IRET+1
      INS1 = INS1+1

C  READ/WRITE USER VALUES
C  ----------------------

      J = INS1
      DO I=1,NSEQ
      DO WHILE(ITP(INV(J,LUN)).LT.2)
      J = J+1
      ENDDO
      IF(IO.EQ.0) USR(I,IRET) = VAL(J,LUN )
      IF(IO.EQ.1) VAL(J,LUN ) = USR(I,IRET)
      J = J+1
      ENDDO

C  CHECK FOR NEXT FRAME
C  --------------------

      GOTO 1

200   CONTINUE

      IF(IRET.EQ.0)  THEN
         IF(IO.EQ.0) THEN
            IF(IPRT.GE.1)  THEN
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      ERRSTR = 'BUFRLIB: UFBSEQ - NO SPECIFIED VALUES READ IN, ' //
     .   'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT(STR)
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL ERRWRT(' ')
            ENDIF
         ELSE
            IF(IPRT.EQ.-1)  IFIRST2 = 1
            IF(IFIRST2.EQ.0 .OR. IPRT.GE.1)  THEN
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      ERRSTR = 'BUFRLIB: UFBSEQ - NO SPECIFIED VALUES WRITTEN OUT, ' //
     .   'SO RETURN WITH 5th ARG. (IRET) = 0; 6th ARG. (STR) ='
      CALL ERRWRT(ERRSTR)
      CALL ERRWRT(STR)
      CALL ERRWRT('MAY NOT BE IN THE BUFR TABLE(?)')
               IF(IPRT.EQ.0) THEN
      ERRSTR = 'Note: Only the first occurrence of this WARNING ' //
     .   'message is printed, there may be more.  To output all ' //
     .   'such messages,'
      CALL ERRWRT(ERRSTR)
      ERRSTR = 'modify your application program to add ' //
     .   '"CALL OPENBF(0,''QUIET'',1)" prior to the first call ' //
     .   'to a BUFRLIB routine.'
      CALL ERRWRT(ERRSTR)
               ENDIF
      CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL ERRWRT(' ')
               IFIRST2 = 1
            ENDIF
         ENDIF
      ENDIF

C  EXITS
C  -----

100   RETURN
900   CALL BORT('BUFRLIB: UFBSEQ - BUFR FILE IS CLOSED, IT MUST BE'//
     . ' OPEN')
901   CALL BORT('BUFRLIB: UFBSEQ - A MESSAGE MUST BE OPEN IN BUFR '//
     . 'FILE, NONE ARE')
902   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - THE INPUT STRING (",A,") '//
     . 'DOES NOT CONTAIN ANY MNEMONICS!!")') STR
      CALL BORT(BORT_STR)
903   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - THERE CANNOT BE MORE THAN '//
     . 'ONE MNEMONIC IN THE INPUT STRING (",A,") (HERE THERE ARE ",I3'//
     . ',")")') STR,NTAG
      CALL BORT(BORT_STR)
904   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - THIRD ARGUMENT (INPUT) MUST'//
     . ' BE .GT. ZERO (HERE IT IS",I4,") - INPUT MNEMONIC IS ",A)')
     . I1,TAGS(1)
      CALL BORT(BORT_STR)
905   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - FOURTH ARGUMENT (INPUT) '//
     . 'MUST BE .GT. ZERO (HERE IT IS",I4,") - INPUT MNEMONIC IS ",A)')
     . I2,TAGS(1)
      CALL BORT(BORT_STR)
906   CALL BORT('BUFRLIB: UFBSEQ - LOCATION OF INTERNAL TABLE FOR '//
     . 'BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN INTERNAL '//
     . 'SUBSET ARRAY')
907   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - INPUT MNEMONIC ",A," MUST '//
     . 'BE A SEQUENCE (HERE IT IS TYPE """,A,""")")') TAGS(1),TYP(NODE)
      CALL BORT(BORT_STR)
908   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - INPUT SEQ. MNEM. ",A,'//
     . '" CONSISTS OF",I4," TABLE B MNEM., .GT. THE MAX. SPECIFIED IN'//
     . ' (INPUT) ARGUMENT 3 (",I3,")")') TAGS(1),NSEQ,I1
      CALL BORT(BORT_STR)
909   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - NO. OF ''LEVELS'' READ > '//
     . 'LIMIT OF",I5," IN THE 4-TH ARG. (INPUT) - INCOMPLETE READ '//
     . '(INPUT MNEMONIC IS ",A,")")') I2,TAGS(1)
      CALL BORT(BORT_STR)
910   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - NO. OF ''LEVELS'' WRITTEN '//
     . '(",I5,") .LT. NO. REQUESTED (",I5,") - INCOMPLETE WRITE '//
     . '(INPUT MNEMONIC IS ",A,")")')  IRET,I2,TAGS(1)
      CALL BORT(BORT_STR)
911   WRITE(BORT_STR,'("BUFRLIB: UFBSEQ - VARIABLE INS1 MUST BE .GE. '//
     . 'ZERO, HERE IT IS",I4," - INPUT MNEMONIC IS ",A)') INS1,TAGS(1)
      CALL BORT(BORT_STR)
      END
